home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / comm / bbs / infodesk.lha / InfoDesk.Basic next >
Encoding:
Text File  |  1990-09-30  |  7.9 KB  |  302 lines
  1. 1 DEFLNG a-z:cr$=CHR$(13)+CHR$(10):de$=CHR$(8)+" "+CHR$(8)
  2.  
  3. ON ERROR GOTO Errors
  4.  
  5. '2 rtime$="30":uname$="SYSOP":id$="1":lev$="9":bd$="2400":ring$="0"
  6. '3 path$="dh1:metro/doorfiles/door18/"
  7. '4 test$="YES"
  8.  
  9. 2 CLOSE#2:OPEN "I",#2,"RAM:USERDATA":LINE INPUT#2,rtime$:LINE INPUT#2,uname$
  10. 3 LINE INPUT#2,id$:LINE INPUT#2,lev$:LINE INPUT#2,bd$:LINE INPUT#2,ring$
  11. 4 LINE INPUT#2,path$:CLOSE#2
  12.  
  13. 5 rtime=VAL(rtime$):id=VAL(id$):lev=VAL(lev$):ring=VAL(ring$):GOSUB modem.o
  14. 6 ON TIMER(60) GOSUB t.dec
  15. 7 Title$="The Info Desk v1.0   ID:"+STR$(id)+"  "+uname$+"  Lev:"+STR$(lev)
  16. 8 WINDOW 1,Title$,(0,0)-(617,185),7,-1:WINDOW OUTPUT 1:TIMER ON
  17.  
  18. MAXSUB=25:maxlines=23
  19.  
  20. SetUp:
  21.   DIM subject$(MAXSUB,2)
  22.   flnm$=path$+"Main.Dat"
  23.   GOSUB LoadMenu
  24.  
  25. Title:
  26.   o$=cr$+cr$+cr$+cr$+"    The Info Desk"+cr$:GOSUB modem.out
  27.   o$="          by"+cr$:GOSUB modem.out
  28.   o$="    Mark D. Turner"+cr$:GOSUB modem.out
  29.  
  30. MainMenu:
  31.   GOSUB TimeCheck
  32.   o$=cr$+cr$+cr$+"      MAIN MENU"+cr$+cr$:GOSUB modem.out
  33.   o$=" <R>ead a subject"+cr$:GOSUB modem.out
  34.   o$=" <S>uggest a topic"+cr$:GOSUB modem.out
  35.   o$=" <C>hange page length"+cr$:GOSUB modem.out
  36.   IF lev=9 THEN o$=" <M>aintenance"+cr$:GOSUB modem.out
  37.   o$=" <Q>uit"+cr$+cr$:GOSUB modem.out
  38.   o$=" Your choice: ":in=0:il=1:GOSUB modem
  39.   ch$=in$
  40.   IF ch$="R" THEN GOSUB ReadIt:IF newmenu$="YES" THEN GOSUB LoadMenu:GOSUB ReadIt
  41.   IF ch$="S" THEN GOSUB Suggestion
  42.   IF ch$="C" THEN GOSUB ChangePage
  43.   IF ch$="M" AND lev=9 THEN GOSUB Maintenance
  44.   IF ch$="Q" THEN GoodBye
  45. GOTO MainMenu
  46.  
  47. ReadIt:
  48.   newmenu$="NO"
  49.   GOSUB PickSubject
  50.   IF which=0 AND UCASE$(exitmenu$)="NONE" THEN RETURN
  51.   IF which=0 THEN newmenu$="YES":flnm$=path$+exitmenu$+".Dat":CLOSE #2:GOSUB LoadMenu:GOTO ReadIt 
  52.   linect=0
  53.   flnm$=path$+subject$(which,2)+".Dat"
  54. 1000 OPEN "i",#2,flnm$
  55.   WHILE EOF(2)<>-1
  56.     LINE INPUT #2, temp$
  57.     IF LEFT$(temp$,1)="\" THEN newmenu$="YES":flnm$=path$+subject$(which,2)+".Dat":CLOSE #2:GOSUB LoadMenu:GOTO ReadIt
  58.     o$=temp$+cr$:GOSUB modem.out
  59.     linect=linect+1
  60.     IF linect=(maxlines-2) THEN linect=0:GOSUB GoOrQuit:IF go$="Q" THEN CLOSE #2:RETURN
  61.   WEND
  62.   CLOSE #2
  63. 1099 GOSUB AnyKey
  64. GOTO ReadIt
  65.  
  66. LoadMenu:
  67. 2000 OPEN "i",#2,flnm$
  68.   LINE INPUT #2, temp$
  69.   exitmenu$=RIGHT$(temp$,(LEN(temp$)-1))
  70.   ct=0
  71.   WHILE EOF(2)<>-1
  72.     LINE INPUT #2,temp$
  73.     IF temp$<>"" THEN
  74.       ct=ct+1
  75.       pos1=INSTR(temp$,"\")
  76.       subject$(ct,1)=LEFT$(temp$,(pos1-1))
  77.       subject$(ct,2)=RIGHT$(temp$,(LEN(temp$)-pos1))
  78.     END IF
  79.   WEND
  80.   subjects=ct
  81.   CLOSE #2
  82. 2099 RETURN
  83.  
  84. PickSubject:
  85.   GOSUB TimeCheck
  86.   which=0
  87.   o$=cr$:GOSUB modem.out
  88.   FOR ct=1 TO subjects
  89.     IF ct<10 THEN o$=" " ELSE o$=""
  90.     o$=o$+STR$(ct)+"  "+subject$(ct,1)+cr$:GOSUB modem.out
  91.   NEXT ct
  92.   o$="  0  QUIT"+cr$:GOSUB modem.out
  93. PickSubject2:
  94.   o$=cr$+"Which subject (0 -"+STR$(subjects)+")? ":in=4:il=2:GOSUB modem
  95.   which$=in$
  96.   which=VAL(which$)
  97.   IF which<0 OR which>subjects THEN PickSubject2
  98. RETURN
  99.  
  100. Suggestion:
  101.   o$=cr$+cr$+cr$+"What do you suggest for a future topic?"+cr$:in=1:il=78:GOSUB modem
  102.   sug$=in$
  103.   IF sug$="" THEN RETURN
  104.   flnm$=path$+"Suggest.Dat"
  105.   OPEN "a",#2,flnm$
  106.   PRINT#2,sug$
  107.   CLOSE #2
  108.   o$=cr$+"Thanks for the idea!"+cr$:GOSUB modem.out
  109.   GOSUB AnyKey
  110. RETURN
  111.  
  112. ChangePage:
  113.   o$=cr$+cr$+cr$+"How many lines are on your screen? ":in=4:il=4:GOSUB modem
  114.   temp=VAL(in$)
  115.   IF temp>0 THEN maxlines=temp ELSE ChangePage
  116. RETURN
  117.  
  118. Maintenance:
  119.   o$=cr$+cr$+cr$+"   MAINTENANCE MENU"+cr$+cr$:GOSUB modem.out
  120.   o$=" <D>elete Suggestions"+cr$:GOSUB modem.out
  121.   o$=" <R>ead Suggestions"+cr$:GOSUB modem.out
  122.   o$=" <Q>uit Maintenance"+cr$:GOSUB modem.out
  123.   o$=cr$+" Your choice: ":in=0:il=1:GOSUB modem
  124.   ch6$=in$
  125.   IF ch6$="D" THEN GOSUB DelSug
  126.   IF ch6$="R" THEN GOSUB ReadSug
  127.   IF ch6$="Q" THEN RETURN
  128. GOTO Maintenance
  129.  
  130. GoodBye:
  131.   o$=cr$+cr$+"Call The Outer Limits - Monday to Friday - 8am to 7pm - 304-327-7452"+cr$+cr$:GOSUB modem.out
  132.   GOTO bye
  133.  
  134. ReadSug:
  135.   o$=cr$+cr$+cr$+"USER'S SUGGESTIONS"+cr$+cr$:GOSUB modem.out
  136.   flnm$=path$+"Suggest.Dat"
  137. 3000 OPEN "i",#2,flnm$
  138.   linect=2
  139.   WHILE EOF(2)<>-1
  140.     LINE INPUT #2,temp$
  141.     o$=temp$+cr$+cr$:GOSUB modem.out
  142.     linect=linect+2
  143.     IF linect=>(maxlines-2) THEN linect=0:GOSUB AnyKey
  144.   WEND
  145.   CLOSE #2
  146. 3099 GOSUB AnyKey
  147. RETURN
  148.  
  149. DelSug:
  150.   o$=cr$+cr$+"Do you want to delete the suggestions (y/N)? ":in=3:il=1:yes=0:GOSUB modem
  151.   IF in$="NO" THEN RETURN
  152.   flnm$=path$+"Suggest.Dat"
  153. 4000 KILL flnm$
  154. 4099 o$="The suggestions have been deleted!"+cr$:GOSUB modem.out
  155.   GOSUB AnyKey
  156. RETURN
  157.  
  158. Errors:
  159.   IF ERL=1000 THEN o$="Sorry, that is not available today."+cr$:GOSUB modem.out:RESUME 1099
  160.   IF ERL=2000 THEN o$="Sorry, that is not available today."+cr$:GOSUB modem.out:RESUME 2099
  161.   IF ERL=3000 THEN o$="No suggestions have been made."+cr$:GOSUB modem.out:RESUME 3099
  162.   IF ERL=4000 THEN RESUME 4099
  163.   o$="Opps!  A program error."+cr$:GOSUB modem.out
  164. STOP
  165.   RESUME GoodBye
  166.  
  167. AnyKey:
  168.   o$=cr$+"Press any key...":in=0:il=1:GOSUB modem
  169.   RETURN
  170.   
  171. GoOrQuit:
  172.   o$=cr$+"<C>ontinue or <Q>uit? ":in=0:il=1:GOSUB modem
  173.   go$=in$
  174.   IF go$="" THEN go$="C"
  175.   IF go$<>"C" AND go$<>"Q" THEN GoOrQuit
  176.   RETURN
  177.  
  178. bye:
  179.   TIMER OFF
  180.   IF test$<>"YES" THEN
  181.     KILL "RAM:USERDATA"
  182.     WINDOW CLOSE 1
  183.   END IF
  184.   GOSUB modem.c
  185.   CLEAR
  186. END
  187.  
  188. modem:
  189. GOSUB modem.out:GOSUB modem.in:RETURN
  190.  
  191. modem.out:
  192. IF icon=0 THEN PRINT o$;
  193. IF ring=1 AND no.out=0 THEN PRINT#1,o$;:o$=""
  194. IF (modout=1 OR cmdmenu=1 OR dismsg=1 OR chat=1) THEN GOSUB modem.in
  195. RETURN
  196. mod.out1:
  197. abort=1:RETURN
  198.  
  199. modem.in:
  200. idle=TIMER:key$="":in$="":a$="":mi$="":a=0:keyy=0:b=0
  201. WHILE keyy<>1
  202.  key$=INKEY$:IF key$<>"" THEN mod.in1
  203.  IF ring=1 THEN
  204.   cd=PEEKL(12570624&):cd=cd AND 8192
  205.   IF cd<>0 THEN bye
  206.   IF LOC(1) THEN a$=INPUT$(1,1):key$=a$
  207.  END IF
  208. mod.in1:
  209. IF key$=CHR$(19) THEN
  210.  pau$="":paused=TIMER
  211.  WHILE TIMER<paused+45
  212.   pau$=INKEY$
  213.   IF pau$<>"" THEN key$="":pau$="":GOTO mod.in1.1
  214.   IF ring=1 THEN
  215.    IF LOC(1) THEN key$="":pau$="":GOTO mod.in1.1
  216.   END IF
  217.  WEND
  218.  key$="":pau$=""
  219. END IF
  220. mod.in1.1:
  221. IF (modout=1 OR cmdmenu=1 OR dismsg=1 OR chat=1) AND key$="" THEN keyy=1
  222. IF modout=1 AND key$=CHR$(32) THEN mod.out1
  223. IF modout=1 AND key$<>CHR$(32) THEN keyy=1
  224. IF cmdmenu=1 AND key$<>"" THEN cmd=1
  225. IF dismsg=1 AND key$<>"" THEN cmd=1
  226. IF key$="" THEN mod.in2
  227. mod.in1.5:
  228. a=ASC(key$):b=LEN(in$)
  229. IF a=13 THEN mod.in1.6
  230. IF a=129 THEN bye
  231. IF (a=8 OR a=127) AND LEN(in$)>=1 THEN
  232.  in$=LEFT$(in$,b-1):b=b-1:o$=de$:GOSUB modem.out
  233. END IF
  234. IF b=il THEN mod.in2
  235. IF in=0 THEN
  236.  IF a>31 AND a<127 THEN
  237.   IF cmd=1 THEN cmdmenu=0:dismsg=0
  238.   key$=UCASE$(key$):o$=key$+cr$:GOSUB modem.out:in$=key$:keyy=1
  239.  END IF
  240. END IF
  241. mod.in1.6:
  242. IF in=1 AND a>31 AND a<127 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  243. IF in=2 AND a>31 AND a<127 THEN
  244.  key$=UCASE$(key$):o$=key$:GOSUB modem.out:in$=in$+key$
  245. END IF
  246. IF in=3 THEN
  247.  IF a=13 AND yes=1 THEN o$="YES":GOSUB modem.out:in$="YES":keyy=1
  248.  IF a=13 AND yes=0 THEN o$="NO":GOSUB modem.out:in$="NO":keyy=1
  249.  IF a=89 OR a=121 THEN o$="YES"+cr$:GOSUB modem.out:in$="YES":keyy=1
  250.  IF a=78 OR a=110 THEN o$="NO"+cr$:GOSUB modem.out:in$="NO":keyy=1
  251. END IF
  252. IF in=4 AND a>47 AND a<58 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  253.  
  254. IF a=13 THEN o$=cr$:GOSUB modem.out:keyy=1
  255. mod.in2:
  256. IF TIMER>idle+300 THEN
  257.  IF sysop=1 AND logon=0 AND TIMER>idle+600 THEN bye
  258.  IF lev>7 AND TIMER>idle+600 THEN bye
  259.  IF lev<8 THEN bye
  260. END IF
  261. mod.in2.0:
  262. WEND
  263.  
  264. IF ring=1 THEN
  265.  IF LOC(1) THEN mi$=INPUT$(LOF(1),1):mi$=""
  266. END IF
  267. mod.in2.1:
  268. RETURN
  269.  
  270. time1:
  271. t.t=FRE(""):time1$=TIME$:t.t=VAL(LEFT$(time1$,2))
  272. IF t.t>11 THEN a$=" PM"
  273. IF t.t<12 THEN a$=" AM"
  274. IF t.t=0 THEN t.t=12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  275. IF t.t<10 THEN time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6):GOTO timeout
  276. IF t.t>21 THEN
  277.  t.t=t.t-12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  278. END IF
  279. IF t.t>12 THEN t.t=t.t-12:time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6)
  280. timeout:
  281. time1$=time1$+a$+"  "+DATE$:RETURN
  282.  
  283. TimeCheck:
  284. GOSUB time1
  285. IF rtime<=0 THEN
  286.  o$=cr$+cr$+"Sorry, Time Limit Exceeded!":GOSUB modem.out:GOTO bye
  287. END IF
  288. RETURN
  289.  
  290. t.dec:
  291. rtime=rtime-1
  292. RETURN
  293.  
  294. delayy:
  295. pause=TIMER:WHILE TIMER<pause+tt:WEND:RETURN
  296.  
  297. modem.c:
  298. CLOSE#1:RETURN
  299.  
  300. modem.o:
  301. OPEN "COM1:"+bd$+",n,8,1" AS #1 LEN=2048:RETURN
  302.